home *** CD-ROM | disk | FTP | other *** search
/ Java Programmer's Toolkit / Java Programmer's Toolkit.iso / gs3.53 / font2c.ps < prev    next >
Text File  |  1996-01-10  |  19KB  |  655 lines

  1. %    Copyright (C) 1992, 1993, 1994, 1995 Aladdin Enterprises.  All rights reserved.
  2. % This file is part of Aladdin Ghostscript.
  3. % Aladdin Ghostscript is distributed with NO WARRANTY OF ANY KIND.  No author
  4. % or distributor accepts any responsibility for the consequences of using it,
  5. % or for whether it serves any particular purpose or works at all, unless he
  6. % or she says so in writing.  Refer to the Aladdin Ghostscript Free Public
  7. % License (the "License") for full details.
  8. % Every copy of Aladdin Ghostscript must include a copy of the License,
  9. % normally in a plain ASCII text file named PUBLIC.  The License grants you
  10. % the right to copy, modify and redistribute Aladdin Ghostscript, but only
  11. % under certain conditions described in the License.  Among other things, the
  12. % License requires that the copyright notice and this notice be preserved on
  13. % all copies.
  14.  
  15. % font2c.ps
  16. % Write out a PostScript Type 0 or Type 1 font as C code
  17. % that can be linked with the interpreter.
  18. % This even works on protected fonts, if you use the -dWRITESYSTEMDICT
  19. % switch in the command line.  The code is reentrant and location-
  20. % independent and has no external references, so it can be put into
  21. % a sharable library even on VMS.
  22.  
  23. % Define the maximum string length that all compilers will accept.
  24. % This must be approximately
  25. %    min(max line length, max string literal length) / 4 - 5.
  26.  
  27. /font2cdict 100 dict dup begin
  28.  
  29. /max_wcs 50 def
  30.  
  31. % Define a temporary file for writing out procedures.
  32. /wtempname (_.tmp) def
  33.  
  34. % ------ Protection utilities ------ %
  35.  
  36. % Protection values are represented by a mask:
  37. /a_noaccess 0 def
  38. /a_executeonly 1 def
  39. /a_readonly 3 def
  40. /a_all 7 def
  41. /prot_names
  42.  [ (0) (a_execute) null (a_readonly) null null null (a_all)
  43.  ] def
  44. /prot_opers
  45.  [ {noaccess} {executeonly} {} {readonly} {} {} {} {}
  46.  ] def
  47.  
  48. % Get the protection of an object.
  49.    /getpa
  50.     { dup wcheck
  51.        { pop a_all }
  52.        {    % Check for executeonly or noaccess objects in protected.
  53.          dup protected exch known
  54.       { protected exch get }
  55.       { pop a_readonly }
  56.      ifelse
  57.        }
  58.       ifelse
  59.     } bind def
  60.  
  61. % Get the protection appropriate for (all the) values in a dictionary.
  62.    /getva
  63.     { a_noaccess exch
  64.        { exch pop
  65.          dup type dup /stringtype eq 1 index /arraytype eq or
  66.      exch /packedarraytype eq or
  67.       { getpa a_readonly and or }
  68.       { pop pop a_all exit }
  69.      ifelse
  70.        }
  71.       forall
  72.     } bind def
  73.  
  74. % Keep track of executeonly and noaccess objects,
  75. % but don't let the protection actually take effect.
  76. .currentglobal
  77. false .setglobal    % so protected can reference local objs
  78. /protected        % do first so // will work
  79.   systemdict wcheck { 1500 dict } { 1 dict } ifelse
  80. def
  81. systemdict wcheck not
  82.  { (Warning: you will not be able to convert protected fonts.\n) print
  83.    (If you need to convert a protected font, please\n) print
  84.    (restart the program and specify the -dWRITESYSTEMDICT switch.\n) print
  85.    flush
  86.    (%end) .skipeof
  87.  }
  88. if
  89. userdict begin
  90.   /executeonly
  91.    { dup //protected exch //a_executeonly put readonly
  92.    } bind def
  93.   /noaccess
  94.    { dup //protected exch //a_noaccess put readonly
  95.    } bind def
  96. end
  97. true .setglobal
  98. systemdict begin
  99.   /executeonly
  100.    { userdict /executeonly get exec
  101.    } bind odef
  102.   /noaccess
  103.    { userdict /noaccess get exec
  104.    } bind odef
  105. end
  106. %end
  107. .setglobal
  108.  
  109. % ------ Output utilities ------ %
  110.  
  111. % By convention, the output file is named cfile.
  112.  
  113. % Define some utilities for writing the output file.
  114.    /wtstring 100 string def
  115.    /wb {cfile exch write} bind def
  116.    /ws {cfile exch writestring} bind def
  117.    /wl {ws (\n) ws} bind def
  118.    /wt {wtstring cvs ws} bind def
  119.  
  120. % Write a C string.  Some compilers have unreasonably small limits on
  121. % the length of a string literal or the length of a line, so every place
  122. % that uses wcs must either know that the string is short,
  123. % or be prepared to use wcca instead.
  124.    /wbx
  125.     { 8#1000 add 8 (0000) cvrs dup 0 (\\) 0 get put ws
  126.     } bind def
  127.    /wcst
  128.     [
  129.       32 { /wbx load } repeat
  130.       95 { /wb load } repeat
  131.       129 { /wbx load } repeat
  132.     ] def
  133.    ("\\) { wcst exch { (\\) ws wb } put } forall
  134.    /wcs
  135.     { (") ws { dup wcst exch get exec } forall (") ws
  136.     } bind def
  137.    /can_wcs    % Test if can use wcs
  138.     { length max_wcs le
  139.     } bind def
  140.    /wncs    % name -> C string
  141.     { wtstring cvs wcs
  142.     } bind def
  143. % Write a C string as an array of character values.
  144. % We only need this because of line and literal length limitations.
  145.    /wca        % <string> <prefix> <suffix> wca -
  146.     { 0 4 -2 roll exch
  147.        {    % Stack: suffix n prefix char
  148.      exch ws
  149.      exch dup 19 ge { () wl pop 0 } if 1 add
  150.      exch dup 32 ge 1 index 126 le and
  151.       { 39 wb dup 39 eq 1 index 92 eq or { 92 wb } if wb 39 wb }
  152.       { wt }
  153.      ifelse (,)
  154.        } forall
  155.       pop pop ws
  156.     } bind def
  157.    /wcca    % <string> wcca -
  158.     { ({\n) (}) wca
  159.     } bind def
  160.  
  161. % Write object protection attributes.  Note that dictionaries are
  162. % the only objects that can be writable.
  163.    /wpa
  164.     { dup xcheck { (a_executable|) ws } if
  165.       dup type /dicttype eq { getpa } { getpa a_readonly and } ifelse
  166.       prot_names exch get ws
  167.     } bind def
  168.    /wva
  169.     { getva prot_names exch get ws
  170.     } bind def
  171.  
  172. % ------ Object writing ------ %
  173.  
  174.    /wnstring 128 string def
  175.  
  176. % Write a string/name or null as an element of a string/name/null array. */
  177.    /wsn
  178.     { dup null eq
  179.        { pop (\t255,255,) wl
  180.        }
  181.        { dup type /nametype eq { wnstring cvs } if
  182.          dup length 256 idiv wt (,) ws
  183.      dup length 256 mod wt
  184.      (,) (,\n) wca
  185.        }
  186.       ifelse
  187.     } bind def
  188. % Write a packed string/name/null array.
  189.    /wsna    % <name> <(string|name|null)*> wsna -
  190.     { (\tstatic const char ) ws exch wt ([] = {) wl
  191.       { wsn } forall
  192.       (\t0\n};) wl
  193.     } bind def
  194.  
  195. % Write a number or an array of numbers, as refs.
  196. /isnumber
  197.  { type dup /integertype eq exch /realtype eq or
  198.  } bind def
  199. /wnums
  200.  { dup isnumber
  201.     { (real_v\() ws wt (\),) ws }
  202.     { { wnums } forall }
  203.    ifelse
  204.  } bind def
  205.  
  206. % Test whether a procedure or unusual array can be written (printed).
  207. /iswx 4 dict dup begin
  208.   /arraytype { { iswproc } isall } def
  209.   /nametype { pop true } def
  210.   /operatortype { pop true } def    % assume it has been bound in
  211.   /packedarraytype /arraytype load def
  212. end def
  213. /iswnx 6 dict dup begin
  214.   /arraytype { { iswproc } isall } def
  215.   /integertype { pop true } def
  216.   /nametype { pop true } def
  217.   /realtype { pop true } def
  218.   /stringtype { pop true } def
  219.   /packedarraytype /arraytype load def
  220. end def
  221. /iswproc    % <obj> iswproc <bool>
  222.  { dup xcheck { iswx } { iswnx } ifelse
  223.    1 index type .knownget { exec } { pop false } ifelse
  224.  } bind def
  225.  
  226. % Write a printable procedure (one for which iswproc returns true).
  227. /wproca 3 dict dup begin
  228.   /arraytype
  229.    { 1 index ({) writestring
  230.       { 1 index ( ) writestring 1 index exch wproc } forall
  231.      (}) writestring
  232.    } bind def
  233.   /packedarraytype /arraytype load def
  234.   /operatortype { .writecvs } bind def    % assume binding would work
  235. end def
  236. /wproc        % <file> <proc> wproc -
  237.  { dup type wproca exch .knownget { exec } { write==only } ifelse
  238.  } bind def
  239.  
  240. % Write a named object.  Return true if this was possible.
  241. % Legal types are: boolean, integer, name, real, string,
  242. % array of (integer, integer+real, name, null+string),
  243. % and certain procedures and other arrays (see iswproc above).
  244. % All other objects are either handled specially or ignored.
  245.    /isall    % <array> <proc> isall <bool>
  246.     { true 3 -1 roll
  247.        { 2 index exec not { pop false exit } if }
  248.       forall exch pop
  249.     } bind def
  250.    /wott 8 dict dup begin
  251.       /arraytype
  252.        { woatt
  253.           { aload pop 2 index 2 index exec
  254.          { exch pop exec exit }
  255.          { pop pop }
  256.         ifelse
  257.       }
  258.      forall
  259.        } bind def
  260.       /booleantype
  261.        { { (\tmake_true\(&) } { (\tmake_false\(&) } ifelse ws
  262.          wt (\);) wl true
  263.        } bind def
  264.       /integertype
  265.        { (\tmake_int\(&) ws exch wt (, ) ws
  266.          wt (\);) wl true
  267.        } bind def
  268.       /nametype
  269.        { (\tcode = (*pprocs->name_create)\(&) ws exch wt
  270.          (, ) ws wnstring cvs wcs    % OK, names are short
  271.      (\);) wl
  272.      (\tif ( code < 0 ) return code;) wl
  273.      true
  274.        } bind def
  275.       /packedarraytype
  276.     /arraytype load def
  277.       /realtype
  278.        { (\tmake_real\(&) ws exch wt (, ) ws
  279.          wt (\);) wl true
  280.        } bind def
  281.       /stringtype
  282.        { ({\tstatic const char s_[] = ) ws
  283.          dup dup can_wcs { wcs } { wcca } ifelse
  284.      (;) wl
  285.      (\tmake_const_string\(&) ws exch wt
  286.      (, a_readonly, ) ws length wt (, (const byte *)s_\);) wl
  287.      (}) wl true
  288.        } bind def
  289.    end def
  290. % Write some other kind of object, if known.
  291.    /wother
  292.     { dup otherobjs exch known
  293.        { otherobjs exch get (\t) ws exch wt ( = ) ws wt (;) wl true }
  294.        { pop pop false }
  295.       ifelse
  296.     } bind def
  297. % Top-level procedure.
  298.    /wo        % name obj -> OK
  299.     { dup type wott exch .knownget { exec } { wother } ifelse
  300.     } bind def
  301.  
  302. % Write an array (called by wo).
  303.    /wap        % <name> <array> wap -
  304.     { dup xcheck not 1 index wcheck not and 1 index rcheck and
  305.        { pop pop }
  306.        { (\tr_set_attrs\(&) ws exch wt (, ) ws wpa (\);) wl }
  307.       ifelse
  308.     } bind def
  309.    /wnuma    % name array C_type type_v ->
  310.     { ({\tstatic const ref_\() ws exch ws
  311.       (\) a_[] = {) wl exch
  312.       dup length 0 eq
  313.        { (\t) ws 1 index ws (\(0\)) wl
  314.        }
  315.        { dup
  316.           { (\t) ws 2 index ws (\() ws wt (\),) wl
  317.       } forall
  318.        }
  319.       ifelse
  320.       (\t};) wl exch pop
  321.       (\tmake_const_array\(&) ws exch wt
  322.       (, avm_foreign|) ws dup wpa (, ) ws length wt
  323.       (, (const ref *)a_\);) wl
  324.       (}) wl
  325.     } bind def
  326.    /woatt [
  327.     % Integers
  328.      { { { type /integertype eq } isall }
  329.        { (long) (integer_v) wnuma true }
  330.      }
  331.     % Integers + reals
  332.      { { { type dup /integertype eq exch /realtype eq or } isall }
  333.        { (float) (real_v) wnuma true }
  334.      }
  335.     % Strings + nulls
  336.      { { { type dup /nulltype eq exch /stringtype eq or } isall }
  337.        { ({) ws dup (sa_) exch wsna
  338.      (\tcode = (*pprocs->string_array_create)\(&) ws exch wt
  339.      (, sa_, ) ws dup length wt (, ) ws wpa (\);) wl
  340.      (\tif ( code < 0 ) return code;) wl
  341.      (}) wl true
  342.        }
  343.      }
  344.     % Names
  345.      { { { type /nametype eq } isall }
  346.        { ({) ws dup (na_) exch wsna
  347.      (\tcode = (*pprocs->name_array_create)\(&) ws 1 index wt
  348.      (, na_, ) ws dup length wt (\);) wl
  349.      (\tif ( code < 0 ) return code;) wl
  350.      wap (}) wl true
  351.        }
  352.      }
  353.     % Procedure
  354.      { { iswproc }
  355.        {    % We'd like to use == and write directly to a string,
  356.         % but we can't do the former because of operators,
  357.         % and we can't do the latter because we can't predict
  358.         % how long the string would have to be....
  359.      wtempname (w) file 2 copy exch wproc closefile
  360.      wtempname status pop pop pop exch pop string
  361.      wtempname (r) file dup 3 -1 roll readstring pop exch closefile
  362.         % Stack: name proc string
  363.      ({\tstatic const char s_[] = ) ws
  364.          dup dup can_wcs { wcs } { wcca } ifelse
  365.      (;) wl
  366.      (\tcode = (*pprocs->ref_from_string)\(&) ws 2 index wt
  367.      (, s_, ) ws length wt (\);) wl
  368.      (\tif ( code < 0 ) return code;) wl
  369.      wap (}) wl true
  370.      wtempname deletefile
  371.        }
  372.      }
  373.     % Default
  374.      { { pop true }
  375.        { wother }
  376.      }
  377.    ] def
  378.  
  379. % Write a named dictionary.  We assume the ref is already declared.
  380.    /wd        % <name> <dict> <extra> wd -
  381.     { 3 1 roll
  382.       ({) ws
  383.       (\tref v_[) ws dup length wt (];) wl
  384.       dup [ exch
  385.        { counttomark 2 sub wtstring cvs
  386.          (v_[) exch concatstrings (]) concatstrings exch wo not
  387.           { (Skipping ) print ==only (....\n) print }
  388.      if
  389.        } forall
  390.       ]
  391.         % Stack: array of keys (names)
  392.       ({) ws dup (str_keys_) exch wsna
  393.       (\tstatic const cfont_dict_keys keys_ =) wl
  394.       (\t { 0, 0, ) ws length wt (, ) ws 3 -1 roll wt (, ) ws
  395.       dup wpa (, ) ws dup wva ( };) wl pop
  396.       (\tcode = \(*pprocs->ref_dict_create\)\(&) ws wt
  397.       (, &keys_, str_keys_, v_\);) wl
  398.       (\tif ( code < 0 ) return code;) wl
  399.       (}) wl
  400.       (}) wl
  401.     } bind def
  402.  
  403. % Write character dictionary keys.
  404. % We save a lot of space by abbreviating keys which appear in
  405. % StandardEncoding or ISOLatin1Encoding.
  406. % Writes code to declare and initialize enc_keys_, str_keys, and keys_.
  407. /wcdkeys    % <dict> wcdkeys -
  408.  {    % Write keys present in StandardEncoding or ISOLatin1Encoding,
  409.     % pushing other keys on the o-stack.
  410.    (static const charindex enc_keys_[] = {) wl
  411.    dup [ exch 0 exch
  412.     { pop decoding 1 index known
  413.        { decoding exch get ({) ws dup -8 bitshift wt
  414.      (,) ws 255 and wt (}, ) ws
  415.      1 add dup 5 mod 0 eq { (\n) ws } if
  416.        }
  417.        { exch }
  418.       ifelse
  419.     }
  420.    forall pop
  421.    ]
  422.    ({0,0}\n};) wl
  423.     % Write other keys.
  424.    (str_keys_) exch wsna
  425.     % Write the declaration for keys_.
  426.    (static const cfont_dict_keys keys_ = {) wl
  427.    (\tenc_keys_, countof\(enc_keys_\) - 1,) wl
  428.    (\t) ws dup length wt ( - \(countof\(enc_keys_\) - 1\), 0, ) ws
  429.    dup wpa (, ) ws wva () wl
  430.    (};) wl
  431.  } bind def
  432.  
  433. % Enumerate character dictionary values in the same order that
  434. % the keys appear in enc_keys_ and str_keys_.
  435. % <proc> is called with each value in turn.
  436. /cdforall    % <dict> <proc> cdforall -
  437.  { 2 copy
  438.     { decoding 3 index known
  439.        { 3 -1 roll pop exec }
  440.        { pop pop pop }
  441.       ifelse
  442.     }
  443.    /exec cvx 3 packedarray cvx
  444.    /forall cvx
  445.    5 -2 roll
  446.     { decoding 3 index known
  447.        { pop pop pop }
  448.        { 3 -1 roll pop exec }
  449.       ifelse
  450.     }
  451.    /exec cvx 3 packedarray cvx
  452.    /forall cvx
  453.    6 packedarray cvx exec
  454.  } bind def
  455.  
  456. % ------ Writers for special objects ------ %
  457.  
  458. /writespecial 10 dict dup begin
  459.  
  460.    /FontInfo { 0 wd } def
  461.  
  462.    /Private { 0 wd } def
  463.  
  464.    /CharStrings
  465.     { ({) wl
  466.       dup wcdkeys
  467.       (static const char values_[] = {) wl
  468.        { wsn } cdforall
  469.       (\t0\n};) wl
  470.       (\tcode = \(*pprocs->string_dict_create\)\(&) ws wt
  471.       (, &keys_, str_keys_, values_\);) wl
  472.       (\tif ( code < 0 ) return code;) wl
  473.       (}) wl
  474.     } bind def
  475.  
  476.    /Metrics
  477.     { ({) wl
  478.       dup wcdkeys
  479.       (static const ref_(float) values_[] = {) wl
  480.       dup { (\t) ws wnums () wl } cdforall
  481.       (\t0\n};) wl
  482.       (static const char lengths_[] = {) wl
  483.        { (\t) ws dup isnumber
  484.       { pop 0 }
  485.       { length 1 add }
  486.      ifelse wt (,) wl
  487.        } cdforall
  488.       (\t0\n};) wl
  489.       (\tcode = \(*pprocs->num_dict_create\)\(&) ws wt
  490.       (, &keys_, str_keys_, (const ref *)values_, lengths_\);) wl
  491.       (\tif ( code < 0 ) return code;) wl
  492.       (}) wl
  493.     } bind def
  494.  
  495.    /Metrics2 /Metrics load def
  496.  
  497.    /FDepVector pop    % (converted to a list of font names)
  498.  
  499. end def
  500.  
  501. % ------ The main program ------ %
  502.  
  503. % Construct an inverse dictionary of encodings.
  504. [ /StandardEncoding /ISOLatin1Encoding
  505.   /SymbolEncoding /DingbatsEncoding
  506.   /KanjiSubEncoding
  507. ]
  508. dup length dict begin
  509.  { mark exch dup { .findencoding exch def } stopped cleartomark
  510.  } forall
  511. currentdict end /encodingnames exch def
  512.  
  513. % Invert the StandardEncoding and ISOLatin1Encoding vectors.
  514. 512 dict begin
  515.   0 1 255 { dup ISOLatin1Encoding exch get exch 256 add def } for
  516.   0 1 255 { dup StandardEncoding exch get exch def } for
  517. currentdict end /decoding exch def
  518.  
  519. /writefont        % cfilename procname -> [writes the current font]
  520.  { (gsf_) exch concatstrings
  521.      /fontprocname exch def
  522.    /cfname exch def
  523.    /cfile cfname (w) file def
  524.  
  525. % Remove unwanted keys from the font.
  526.    currentfont dup length dict begin { def } forall
  527.     { /FID /MIDVector /CurMID } { currentdict exch undef } forall
  528.    /Font currentdict end def
  529.  
  530. % Replace the FDepVector with a list of font names.
  531.    Font /FDepVector .knownget
  532.     { [ exch { /FontName get } forall ]
  533.       Font /FDepVector 3 -1 roll put
  534.     }
  535.    if
  536.  
  537. % Find all the special objects we know about.
  538. % wo uses this to write out references to otherwise intractable objects.
  539.    /otherobjs writespecial length dict dup begin
  540.      writespecial
  541.       { pop Font 1 index .knownget { exch def } { pop } ifelse
  542.       }
  543.      forall
  544.    end def
  545.  
  546. % Define a dummy FontInfo, in case the font doesn't have one.
  547.    /FontInfo 0 dict def
  548.  
  549. % Write out the boilerplate.
  550.    Font begin
  551.    (/****************************************************************) wl
  552.    (   Portions of this file are subject to the following notice(s):) wl
  553.    systemdict /copyright get wl
  554.    FontInfo /Notice .knownget
  555.     { (----------------------------------------------------------------) wl wl
  556.     } if
  557.    (****************************************************************/) wl
  558.    () wl
  559.    (/* ) ws cfname ws ( */) wl
  560.    (/* This file was created by the ) ws product ws ( font2c utility. */) wl
  561.    () wl
  562.    (#undef DEBUG) wl
  563.    (#include "ccfont.h") wl
  564.    () wl
  565.  
  566. % Write the procedure prologue.
  567.    (#ifdef __PROTOTYPES__) wl
  568.    (int huge) wl
  569.    fontprocname ws ((const cfont_procs *pprocs, ref *pfont)) wl
  570.    (#else) wl
  571.    (int huge) wl
  572.    fontprocname ws ((pprocs, pfont) const cfont_procs *pprocs; ref *pfont;) wl
  573.    (#endif) wl
  574.    ({\tint code;) wl
  575.    (\tref Font;) wl
  576.    otherobjs
  577.     { exch pop (\tref ) ws wt (;) wl }
  578.    forall
  579.  
  580. % Write out the special objects.
  581.    otherobjs
  582.     { exch writespecial 2 index get exec
  583.     }
  584.    forall
  585.  
  586. % Write out the main font dictionary.
  587. % If possible, substitute the encoding name for the encoding;
  588. % PostScript code will fix this up.
  589.     { /Encoding /PrefEnc }
  590.     { Font 1 index .knownget
  591.        { encodingnames exch .knownget { def } { pop } ifelse }
  592.        { pop }
  593.       ifelse
  594.     }
  595.    forall
  596.    (Font) Font FontType 0 eq { 5 } { 1 } ifelse wd
  597.  
  598. % Finish the procedural initialization code.
  599.    (\t*pfont = Font;) wl
  600.    (\treturn 0;) wl
  601.    (}) wl
  602.    end                % Font
  603.  
  604.    cfile closefile
  605.  
  606.  } bind def
  607.  
  608. end def            % font2cdict
  609.  
  610. % Compute the procedure name from the font name.
  611. % Replace all non-alphanumeric characters with '_'.
  612. /makefontprocnamemap 256 string
  613.    0 1 255 { 2 copy 95 put pop } for
  614.    (0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz)
  615.     { 2 copy dup put pop } forall
  616. readonly def
  617. /makefontprocname    % <fontname> makefontprocname <procnamestring>
  618.  { dup length string cvs
  619.    dup length 1 sub -1 0
  620.     {        % Stack: string index
  621.       2 copy 2 copy get //makefontprocnamemap exch get put pop
  622.     }
  623.    for 
  624.  } def
  625.  
  626. /writefont { font2cdict begin writefont end } def
  627.  
  628. % If the program was invoked from the command line, run it now.
  629. [ shellarguments
  630.  { counttomark dup 2 eq exch 3 eq or
  631.     { counttomark -1 roll cvn
  632.       (Converting ) print dup =only ( font.\n) print flush
  633.       dup FontDirectory exch known { dup FontDirectory exch undef } if
  634.       findfont setfont
  635.       (FontName is ) print currentfont /FontName get ==only (.\n) print flush
  636.       counttomark 1 eq
  637.        {    % Construct the procedure name from the file name.
  638.          currentfont /FontName get makefontprocname
  639.        }
  640.       if
  641.       writefont
  642.       (Done.\n) print flush
  643.     }
  644.     { cleartomark
  645.       (Usage: font2c fontname cfilename.c [shortname]\n) print
  646.       ( e.g.: font2c Courier cour.c\n) print flush
  647.       mark
  648.     }
  649.    ifelse
  650.  }
  651. if pop
  652.